mtcars
data(mtcars)
x <- as.matrix(mtcars)
rc <- rainbow(nrow(x), start=0, end=.3)
cc <- rainbow(ncol(x), start=0, end=.3)
##
## demonstrate the effect of row and column dendrogram options
##
heatmap.2(x) ## default - dendrogram plotted and reordering done.
heatmap.2(x, dendrogram="none") ## no dendrogram plotted, but reordering done.
heatmap.2(x, dendrogram="row") ## row dendrogram plotted and row reordering done.
heatmap.2(x, dendrogram="col") ## col dendrogram plotted and col reordering done.
heatmap.2(x, keysize=2) ## default - dendrogram plotted and reordering done.
heatmap.2(x, Rowv=FALSE, dendrogram="both") ## generates a warning!
## Warning in heatmap.2(x, Rowv = FALSE, dendrogram = "both"): Discrepancy: Rowv is
## FALSE, while dendrogram is `both'. Omitting row dendogram.
heatmap.2(x, Rowv=NULL, dendrogram="both") ## generates a warning!
## Warning in heatmap.2(x, Rowv = NULL, dendrogram = "both"): Discrepancy: Rowv is
## FALSE, while dendrogram is `both'. Omitting row dendogram.
heatmap.2(x, Colv=FALSE, dendrogram="both") ## generates a warning!
## Warning in heatmap.2(x, Colv = FALSE, dendrogram = "both"): Discrepancy: Colv is
## FALSE, while dendrogram is `both'. Omitting column dendogram.
## Reorder dendrogram by branch means rather than sums
heatmap.2(x, reorderfun=function(d, w) reorder(d, w, agglo.FUN = mean) )
## plot a sub-cluster using the same color coding as for the full heatmap
full <- heatmap.2(x)
heatmap.2(x, Colv=full$colDendrogram[[2]], breaks=full$breaks) # column subset
heatmap.2(x, Rowv=full$rowDendrogram[[1]], breaks=full$breaks) # row subset
heatmap.2(x, Colv=full$colDendrogram[[2]],
Rowv=full$rowDendrogram[[1]], breaks=full$breaks) # both
## Show effect of row and column label rotation
heatmap.2(x, srtCol=NULL)
heatmap.2(x, srtCol=0, adjCol = c(0.5,1) )
heatmap.2(x, srtCol=45, adjCol = c(1,1) )
heatmap.2(x, srtCol=135, adjCol = c(1,0) )
heatmap.2(x, srtCol=180, adjCol = c(0.5,0) )
heatmap.2(x, srtCol=225, adjCol = c(0,0) ) ## not very useful
heatmap.2(x, srtCol=270, adjCol = c(0,0.5) )
heatmap.2(x, srtCol=315, adjCol = c(0,1) )
heatmap.2(x, srtCol=360, adjCol = c(0.5,1) )
heatmap.2(x, srtRow=45, adjRow=c(0, 1) )
heatmap.2(x, srtRow=45, adjRow=c(0, 1), srtCol=45, adjCol=c(1,1) )
heatmap.2(x, srtRow=45, adjRow=c(0, 1), srtCol=270, adjCol=c(0,0.5) )
## Show effect of offsetRow/offsetCol (only works when srtRow/srtCol is
## not also present)
heatmap.2(x, offsetRow=0, offsetCol=0)
heatmap.2(x, offsetRow=1, offsetCol=1)
heatmap.2(x, offsetRow=2, offsetCol=2)
heatmap.2(x, offsetRow=-1, offsetCol=-1)
heatmap.2(x, srtRow=0, srtCol=90, offsetRow=0, offsetCol=0)
heatmap.2(x, srtRow=0, srtCol=90, offsetRow=1, offsetCol=1)
heatmap.2(x, srtRow=0, srtCol=90, offsetRow=2, offsetCol=2)
heatmap.2(x, srtRow=0, srtCol=90, offsetRow=-1, offsetCol=-1)
## Show how to use 'extrafun' to replace the 'key' with a scatterplot
lmat <- rbind( c(5,3,4), c(2,1,4) )
lhei <- c(1.5, 4)
lwid <- c(1.5, 4, 0.75)
myplot <- function() {
oldpar <- par("mar")
par(mar=c(5.1, 4.1, 0.5, 0.5))
plot(mpg ~ hp, data=x)
}
heatmap.2(x, lmat=lmat, lhei=lhei, lwid=lwid, key=FALSE, extrafun=myplot)
## show how to customize the color key
heatmap.2(x,
key.title=NA, # no title
key.xlab=NA, # no xlab
key.par=list(mgp=c(1.5, 0.5, 0),
mar=c(2.5, 2.5, 1, 0)),
key.xtickfun=function() {
breaks <- parent.frame()$breaks
return(list(
at=parent.frame()$scale01(c(breaks[1],
breaks[length(breaks)])),
labels=c(as.character(breaks[1]),
as.character(breaks[length(breaks)]))
))
})
heatmap.2(x,
breaks=256,
key.title=NA,
key.xlab=NA,
key.par=list(mgp=c(1.5, 0.5, 0),
mar=c(1, 2.5, 1, 0)),
key.xtickfun=function() {
cex <- par("cex")*par("cex.axis")
side <- 1
line <- 0
col <- par("col.axis")
font <- par("font.axis")
mtext("low", side=side, at=0, adj=0,
line=line, cex=cex, col=col, font=font)
mtext("high", side=side, at=1, adj=1,
line=line, cex=cex, col=col, font=font)
return(list(labels=FALSE, tick=FALSE))
})
##
## Show effect of z-score scaling within columns, blue-red color scale
##
hv <- heatmap.2(x, col=bluered, scale="column", tracecol="#303030")
###
## Look at the return values
###
names(hv)
## [1] "rowInd" "colInd" "call" "colMeans"
## [5] "colSDs" "carpet" "rowDendrogram" "colDendrogram"
## [9] "breaks" "col" "vline" "colorTable"
## [13] "layout"
## Show the mapping of z-score values to color bins
hv$colorTable
## low high color
## 1 -3.2116766 -2.7834531 #0000FF
## 2 -2.7834531 -2.3552295 #2424FF
## 3 -2.3552295 -1.9270060 #4949FF
## 4 -1.9270060 -1.4987824 #6D6DFF
## 5 -1.4987824 -1.0705589 #9292FF
## 6 -1.0705589 -0.6423353 #B6B6FF
## 7 -0.6423353 -0.2141118 #DBDBFF
## 8 -0.2141118 0.2141118 #FFFFFF
## 9 0.2141118 0.6423353 #FFDBDB
## 10 0.6423353 1.0705589 #FFB6B6
## 11 1.0705589 1.4987824 #FF9292
## 12 1.4987824 1.9270060 #FF6D6D
## 13 1.9270060 2.3552295 #FF4949
## 14 2.3552295 2.7834531 #FF2424
## 15 2.7834531 3.2116766 #FF0000
## Extract the range associated with white
hv$colorTable[hv$colorTable[,"color"]=="#FFFFFF",]
## low high color
## 8 -0.2141118 0.2141118 #FFFFFF
## Determine the original data values that map to white
whiteBin <- unlist(hv$colorTable[hv$colorTable[,"color"]=="#FFFFFF",1:2])
rbind(whiteBin[1] * hv$colSDs + hv$colMeans,
whiteBin[2] * hv$colSDs + hv$colMeans )
## cyl am vs carb wt drat gear qsec
## [1,] 5.805113 0.2994102 0.3295842 2.466667 3.007751 3.482081 3.529527 17.46614
## [2,] 6.569887 0.5130898 0.5454158 3.158333 3.426749 3.711044 3.845473 18.23136
## mpg hp disp
## [1,] 18.80018 132.0074 204.1851
## [2,] 21.38107 161.3676 257.2586
##
## A more decorative heatmap, with z-score scaling along columns
##
hv <- heatmap.2(x, col=cm.colors(255), scale="column",
RowSideColors=rc, ColSideColors=cc, margin=c(5, 10),
xlab="specification variables", ylab= "Car Models",
main="heatmap(<Mtcars data>, ..., scale=\"column\")",
tracecol="green", density="density")
## Note that the breakpoints are now symmetric about 0
## Color the labels to match RowSideColors and ColSideColors
hv <- heatmap.2(x, col=cm.colors(255), scale="column",
RowSideColors=rc, ColSideColors=cc, margin=c(5, 10),
xlab="specification variables", ylab= "Car Models",
main="heatmap(<Mtcars data>, ..., scale=\"column\")",
tracecol="green", density="density", colRow=rc, colCol=cc,
srtCol=45, adjCol=c(0.5,1))
data(attitude)
round(Ca <- cor(attitude), 2)
## rating complaints privileges learning raises critical advance
## rating 1.00 0.83 0.43 0.62 0.59 0.16 0.16
## complaints 0.83 1.00 0.56 0.60 0.67 0.19 0.22
## privileges 0.43 0.56 1.00 0.49 0.45 0.15 0.34
## learning 0.62 0.60 0.49 1.00 0.64 0.12 0.53
## raises 0.59 0.67 0.45 0.64 1.00 0.38 0.57
## critical 0.16 0.19 0.15 0.12 0.38 1.00 0.28
## advance 0.16 0.22 0.34 0.53 0.57 0.28 1.00
symnum(Ca) # simple graphic
## rt cm p l rs cr a
## rating 1
## complaints + 1
## privileges . . 1
## learning , . . 1
## raises . , . , 1
## critical . 1
## advance . . . 1
## attr(,"legend")
## [1] 0 ' ' 0.3 '.' 0.6 ',' 0.8 '+' 0.9 '*' 0.95 'B' 1
# with reorder
heatmap.2(Ca, symm=TRUE, margin=c(6, 6), trace="none" )
# without reorder
heatmap.2(Ca, Rowv=FALSE, symm=TRUE, margin=c(6, 6), trace="none" )
## Warning in heatmap.2(Ca, Rowv = FALSE, symm = TRUE, margin = c(6, 6), trace =
## "none"): Discrepancy: Rowv is FALSE, while dendrogram is `both'. Omitting row
## dendogram.
## Warning in heatmap.2(Ca, Rowv = FALSE, symm = TRUE, margin = c(6, 6), trace
## = "none"): Discrepancy: Colv is FALSE, while dendrogram is `column'. Omitting
## column dendogram.
## Place the color key below the image plot
heatmap.2(x, lmat=rbind( c(0, 3), c(2,1), c(0,4) ), lhei=c(1.5, 4, 2 ) )
## Place the color key to the top right of the image plot
heatmap.2(x, lmat=rbind( c(0, 3, 4), c(2,1,0 ) ), lwid=c(1.5, 4, 2 ) )
SpikeIn data
library(affy)
## Loading required package: BiocGenerics
##
## Attaching package: 'BiocGenerics'
## The following objects are masked from 'package:stats':
##
## IQR, mad, sd, var, xtabs
## The following objects are masked from 'package:base':
##
## anyDuplicated, append, as.data.frame, basename, cbind, colnames,
## dirname, do.call, duplicated, eval, evalq, Filter, Find, get, grep,
## grepl, intersect, is.unsorted, lapply, Map, mapply, match, mget,
## order, paste, pmax, pmax.int, pmin, pmin.int, Position, rank,
## rbind, Reduce, rownames, sapply, setdiff, sort, table, tapply,
## union, unique, unsplit, which.max, which.min
## Loading required package: Biobase
## Welcome to Bioconductor
##
## Vignettes contain introductory material; view with
## 'browseVignettes()'. To cite Bioconductor, see
## 'citation("Biobase")', and for packages 'citation("pkgname")'.
data(SpikeIn)
pms <- SpikeIn@pm
# just the data, scaled across rows
heatmap.2(pms, col=rev(heat.colors(16)), main="SpikeIn@pm",
xlab="Relative Concentration", ylab="Probeset",
scale="row")
# fold change vs "12.50" sample
data <- pms / pms[, "12.50"]
data <- ifelse(data>1, data, -1/data)
heatmap.2(data, breaks=16, col=redgreen, tracecol="blue",
main="SpikeIn@pm Fold Changes\nrelative to 12.50 sample",
xlab="Relative Concentration", ylab="Probeset")
